Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Periodicals/develop/develop 2 code/Secret Life of Mem. Mgr./HeapDemo.p

Text File | 1990-05-29 | 12.2 KB | 442 lines | [TEXT/MPS ]

program HeapDemo;
(* Written by Richard Clark (AppleLink, GEnie: RDCLARK *)
(*                              Internet: [e-mail] or [e-mail]) *)
(* Copyright (c) 1989-1990 by Apple Computer, Inc. All Rights Reserved                       *)

(* See the "Globals" file for a description of the program *)

(* Segmentation: Put everything except "UDialogs" into CODE 1. The Dialog file *)
(* goes into CODE 2.                                                                             *)

(* CHANGES SINCE VERSION 1.3.3 *)
(* 1. Removed the spurious reference to "UMonitor" (some personal debugging code) *)
(* 2. Updated menu select logic for the Window and Special menus *)

    uses
        Types, Memory, Menus, Dialogs, SegLoad, Resources, OSUtils, ToolUtils,
        Fonts, Events, OSEvents, Desk, Windows,
        UGlobals, UDialogs, UHeapHandler, UAboutWindow;

    var
        DragLimits, SizeLimits: Rect;


    procedure SafetyNet;
   (* Procedure invoked when you press "resume" in the System Error dialog *)
    begin
        ExitToShell;
    end; (* SafetyNet *)


    procedure InitDemoZone;
     (* This initializes our heap zone records and allocates the "mini" heap zone *)
        var
            miniHeapSize: LONGINT;

    begin
        miniHeapSize := (MyHeapSize * 1024) + HeapBias + HeapTrailer + Slop;
        theMiniHeap := NewPtr(miniHeapSize);  (* get enough room for our zone, plus a 52-byte *)
                                                                      (* header and a 12-byte trailer *)
        InitZone(nil, 64, Ptr(ORD(theMiniHeap) + miniHeapSize), theMiniHeap);
        MyDemoZone := GetZone;

        ZeroHeapInfo(CurrHeap);                    (* Erase the "CurrHeap" array *)
        ZeroHeapInfo(OldHeap);                    (* Erase the "OldHeap" array *)

        UpdateHeapInfo(CurrHeap, kClearDirtyFlags);
        CopyHeapInfo(CurrHeap, OldHeap);         (* Copy such things as the free memory counts *)
        SetZone(MyAppZone);                        (* makse sure that we're in the correct heap zone *)
    end; (* InitDemoZone *)


    procedure Initialize;

        procedure InitMyMenus;
        begin
            AppleMenu := GetMenu(mApple);
            AddResMenu(AppleMenu, 'DRVR');
            InsertMenu(AppleMenu, 0);

            FileMenu := GetMenu(mFile);
            InsertMenu(FileMenu, 0);

            EditMenu := GetMenu(mEdit);
            InsertMenu(EditMenu, 0);

            WindowMenu := GetMenu(mWindow);
            InsertMenu(WindowMenu, 0);

            SpecialMenu := GetMenu(mSpecial);
            InsertMenu(SpecialMenu, 0);

            DrawMenuBar;
        end; (* InitMyMenus *)


        procedure CheckPrefs;
     (* Look at the 'pref' 1000 resource to determine if we should open the Advanced or Novice *)
    (* dialog at startup. If the resource contains $0000 as the first entry, it's the Novice dialog *)
     (* If it contains $FFFF, it's the Advanced. (Actually, I only look at the least signifigant bit of *)
    (* the first byte) *)

            type
                CharPtr = ^CHAR;
                CharHand = ^CharPtr;

            var
                prefsHand: Handle;

        begin
            prefsHand := GetResource('pref', 1000);
            if PrefsHand = nil then
                application.UseExtendedDialog := FALSE
            else
                application.UseExtendedDialog := (ORD(CharHand(prefsHand)^^) <> 0);
            CheckItem(WindowMenu, imSimpleDialog, not application.UseExtendedDialog);
            CheckItem(WindowMenu, imComplexDialog, application.UseExtendedDialog);
        end; (* CheckPrefs *)

        procedure CheckEnvirons;
     (* Look for the 128K (or later) ROMS and WaitNextEvent *)
            var
                rom: integer;       (* Which version of the ROM are we running? *)
                machine: integer; (* Which machine is this?? *)

            function TrapAvailable (tNumber: INTEGER; tType: TrapType): BOOLEAN;

                const
                    UnimplementedTrapNumber = $A89F;  {number of "unimplemented trap"}

            begin {TrapAvailable}

         {Check and see if the trap exists.}
         {On 64K ROM machines, tType will be ignored.}

                TrapAvailable := (NGetTrapAddress(tNumber, tType) <> GetTrapAddress(UnimplementedTrapNumber));

            end;  {TrapAvailable}

            const
                WNETrapNumber = $A860; {trap number of WaitNextEvent}
                TEStylNewTrapNumber = $A83E; { trap number of TEStylNew }

        begin
            Environs(rom, machine);  (* Make sure that we can call SysEnvirons -- the LSP glue doesn't *)
            if (rom >= 117) then      (* This is a Mac 512Ke or later , so we can see if we have WaitNextEvent *)
                begin
                    system.EnhancedROMs := TRUE;
                    system.HasWNE := TrapAvailable(WNETrapNumber, ToolTrap);
                    system.HasStyledTE := TrapAvailable(TEStylNewTrapNumber, ToolTrap);
                end
            else
                begin
                    system.EnhancedROMs := FALSE;
                    system.HasWNE := FALSE;
                    system.HasStyledTE := FALSE;
                end;
        end; (* CheckEnvirons *)

    begin
        MaxApplZone;                                    (* Expand the heap to full size *)
        MoreMasters;                                (* Allocate 64 Mac Programmers *)
        MoreMasters;

        InitGraf(@ThePort);                            (* Just your everyday ROM initialization *)
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(@SafetyNet);
        InitMyMenus;

        DragLimits := screenBits.bounds;
        InsetRect(dragLimits, 4, 4);
        DragLimits.top := 40;

        SizeLimits := screenBits.bounds;
        InsetRect(SizeLimits, 64, 64);

        MyAppZone := GetZone;                         (* Get and remember the current heap zone *)
        InitDemoZone;                         (* Create the Demo Heap *)
        InitAboutWindow;
        Quit := FALSE;
        FlushEvents(everyEvent, 0);
        CheckEnvirons;                    (* Look for WaitNextEvent *)
        CheckPrefs;                        (* Decide which dialog (Novice or Advanced) to open at startup *)

        InitMyDialogs;                    (* Open the dialog *)
        InitCursor;                        (* Initialize dialog-related global variables *)
    end; (* initialize *)

    procedure CloseAWindow (whichWindow: WindowPtr);
   (* This closes the specified window *)
        var
            wPeek: WindowPeek;
            wKind: integer;

    begin
        wPeek := WindowPeek(whichWindow);     (* See if we have an open window, and find out if it belongs *)
        wKind := wPeek^.windowKind;                (* to a Desk Accessory *)
      (* "CODE FROM MARS" ALERT: We're going directly into the WindowPeek record, but there's *)
     (* no alternative. Look here if the program breaks in the future.                                    *)
        if (wKind < 0) then
            CloseDeskAcc(wKind)                          (* The frontmost window is a D.A., so kill it *)
        else if not CloseIfAboutWindow(whichWindow) then
            case GetWRefCon(whichWindow) of
                MemDialogRefCon:                       (* this is the main display *)
                    CloseMemoryDialog;

                LegendRefCon:                             (* This is the "legend" display *)
                    begin
                        ReleaseResource(Handle(WindowPeek(whichWindow)^.windowPic));
                        DisposeWindow(whichWindow);
                        EnableItem(WindowMenu, imShowLegend);
                    end;

            end; (* GoAway *)
    end;


    procedure DoMenus (menuCode: longint);
        var
            inMenu, inItem: integer;
        (* The following variables are used when opening a desk accessory *)
            oldPort: GrafPtr;
            ItemName: Str255;
            status: integer;
        (* The following is used when closing a window *)
            wKind: integer; (* The WindowKind field of this window *)
        (* The following is used when switching from the basic dialog to the advanced one *)
            oldValue, newValue: Boolean;

        procedure DoApple (inItem: INTEGER);
    (* Handle clicks in the Apple menu *)

        begin
            if inItem = iaAbout then
                OpenAboutWindow
            else
                begin
                    GetPort(oldPort);
                    GetItem(AppleMenu, inItem, ItemName);
                    status := OpenDeskAcc(ItemName);
                    SetPort(oldPort);
                end;
        end; (* DoApple *)

        procedure DoFile (inItem: INTEGER);
        begin
            case inItem of
                ifOpen:
                    OpenMemoryDialog;

                ifClose:
                    CloseAWindow(FrontWindow);

                ifQuit:
                    Quit := TRUE;
            end; (* case inItem *)
        end; (* InItem *)

        procedure DoEdit (inItem: INTEGER);
        begin
         (* It's sure a good thing the Edit menu is disabled, eh? *)
        end; (* DoEdit *)

        procedure DoWindow (inItem: INTEGER);
            var
                legendWindow: WindowPtr;

        begin
            case inItem of
                imSimpleDialog, imComplexDialog:
             (* Switch from the Novice to the Advanced dialog, or vice versa *)
                    begin
                        oldValue := application.UseExtendedDialog;
                        newValue := inItem = imComplexDialog;
                        if (newValue <> oldValue) then
                            begin
                                application.UseExtendedDialog := newValue;
                                CheckItem(WindowMenu, imSimpleDialog, not application.UseExtendedDialog);
                                CheckItem(WindowMenu, imComplexDialog, application.UseExtendedDialog);
                                CloseMemoryDialog;        (* Close the present dialog *)
                                OpenMemoryDialog;         (* Open the new one (which will display the same heap info) *)
                            end;
                    end;

                imShowLegend:
             (* Open a "legend" window, and attach a WindowPic *)
                    begin
                        legendWindow := GetNewWindow(wLegend, nil, WindowPtr(-1));
                        if (legendWindow <> nil) then
                            begin
                                WindowPeek(legendWindow)^.windowPic := PicHandle(GetResource('PICT', 1001));
                                SetWRefCon(legendWindow, LegendRefCon);
                                ShowWindow(legendWindow);
                                DisableItem(WindowMenu, imShowLegend);
                            end;
                    end;

            end; (* CASE *)
        end; (* DoWindow *)


        procedure DoSpecial (inItem: INTEGER);
      (* This routine only supports 1 command: "clear the heap" *)
        begin
            if (theMiniHeap <> nil) then
                if (NoteAlert(aConfirmErase, nil) = 1) then
                    begin
                        DisposPtr(theMiniHeap);
                        InitDemoZone;
                        InitMemoryDialog;
                        InvalItem(dmOldHeap);
                        InvalItem(dmNewHeap);
                        DisableItem(SpecialMenu, isEraseHeap);
                        DrawMenuBar;
                    end;
        end; (* DoSpecial *)

    begin
        if (menuCode <> 0) then
            begin
                inMenu := HiWord(menuCode);
                inItem := LoWord(menuCode);
                case inMenu of
                    mApple:
                        DoApple(inItem);

                    mFile:
                        DoFile(inItem);

                    mEdit:
                        DoEdit(inItem);

                    mWindow:
                        DoWindow(inItem);

                    mSpecial:
                        DoSpecial(inItem);

                end; (* case *)
                HiliteMenu(0);
            end;
    end; (* DoMenus *)


    procedure MainLoop;
        var
            theEvent: EventRecord;
            realEvent: Boolean;

        procedure DoMouseDown (theEvent: EventRecord);
            var
                location: integer;
                WhichWindow: WindowPtr;
                MenuCode: longint;
                sizeCode: longint;

        begin
            location := FindWindow(theEvent.where, whichWindow);
            case location of
                inMenuBar:
                    begin
                        if FrontWindow <> nil then
                            EnableItem(fileMenu, ifClose)
                        else
                            DisableItem(fileMenu, ifClose);
                        MenuCode := MenuSelect(theEvent.where);
                        DoMenus(MenuCode);
                    end;

                inContent:
                    if (whichWindow <> FrontWindow) then
                        begin
                            SelectWindow(whichWindow);                    (* Bring it to the front *)
                            SetPort(whichWindow);
                        end;

                inDrag:
                    DragWindow(whichWindow, theEvent.where, DragLimits);

                inGoAway:
                    if TrackGoAway(whichWindow, theEvent.where) then
                        CloseAWindow(whichWindow);

                inGrow:
                    begin (* Note: Add code to handle scroll bars here also!! *)
                        sizeCode := GrowWindow(whichWindow, theEvent.where, SizeLimits);
                        if (sizeCode <> 0) then
                            SizeWindow(whichWindow, LoWord(sizeCode), HiWord(sizeCode), TRUE);
                    end;

                inZoomIn, inZoomOut:
                    begin
                        ZoomWindow(whichWindow, location, FALSE);   (* We can zoom without coming to the front *)
                (* Add resizing code here too *)
                    end;

                inSysWindow:
                    SystemClick(theEvent, whichWindow);
                otherwise
            end; (* case *)
        end; (* DoMouseDown *)


        procedure DoKeyDown (theEvent: EventRecord);
            var
                ch: char;
                MenuCode: longint;

        begin
            if BitAnd(theEvent.modifiers, cmdKey) <> 0 then
                begin
                    ch := CHR(BitAnd(theEvent.message, charCodeMask));
                    if FrontWindow <> nil then
                        EnableItem(fileMenu, ifClose)
                    else
                        DisableItem(fileMenu, ifClose);
                    MenuCode := MenuKey(ch);
                    DoMenus(menuCode);
                end;
        end; (* DoKeyDown *)


    begin
        repeat
            if (system.HasWNE) then
                realEvent := WaitNextEvent(everyEvent, theEvent, 15, nil)   (* Give up as much time as possible *)
            else
                begin
                    SystemTask;
                    realEvent := GetNextEvent(everyEvent, theEvent);
                end;

            UnloadSeg(@InitMyDialogs);

            if HandleDialogEvents(theEvent) then (* it's been taken care of *)
            else if AboutEventProc(theEvent) then (* Otherwise, this isn't a dialog event, so see if it belongs to the About window *)
            else                (* Otherwise, this event belongs to something other than the About window *)
                case theEvent.what of
                    mouseDown:
                        DoMouseDown(theEvent);

                    keyDown:
                        DoKeyDown(theEvent);

                    otherwise
                end; (* case *)
        until Quit;
    end; (* mainLoop *)

    procedure Shutdown;
    begin
        CloseMemoryDialog;
    end; (* Shutdown *)

begin
    Initialize;
    OpenMemoryDialog;
    MainLoop;
    Shutdown;
end.